#!/usr/bin/env perl

#v0.1

use strict;
use Getopt::Std;
use Term::ReadLine;

my $minpref;
my $maxpref = 0;
my $ndmaxpref = 0;

sub pref_gui {
    $_ = shift @_;
    return $maxpref - $_ - ($maxpref==$_?0:$maxpref - $ndmaxpref - 1);
}

sub pref_norm {
    $_ = shift @_;
    return $_;
}

sub pref_rel {
    $_ = shift @_;
    return $_ - $minpref;
}

sub pref_int {
    $_ = shift @_;
    return $maxpref + 1 - $_;
}

my %options=();
getopts("hgirvf", \%options);

if (defined $options{'h'}){
    print "Usage: stats.perl [-hgvf] [preferences_file] [terms_file] [groups_file] [assignment]\n";
    print "  -h this help\n";
    print "  -v verbose\n";
    print "  -g convert preferences to match these from GUI\n";
    print "  -r relative preferences\n";
    print "  -i internal preferences\n";
    exit 1;
}
my $fav_subj = defined $options{'f'};
my $verbose = defined $options{'v'};
my $relative = defined $options{'r'};
my $internal = defined $options{'i'};
my $gui_like = defined $options{'g'};
my $reversed = $gui_like || $internal;

my $pref_func;
if ($gui_like){
    $pref_func = \&pref_gui;
} elsif ($internal){
    $pref_func = \&pref_int;
} elsif ($relative){
    $pref_func = \&pref_rel;
} else {
    $pref_func = \&pref_norm;
};

## wczytanie terminow
my %subject = ();
my %act_subject;
my $act_subject_id;
my %collisions = (); # collisions{s1}{t1}{s2}{t2}
my $term_cnt = 0;

open(TERMFILE, "<".($ARGV[1] or "terminy.txt"));
while(<TERMFILE>){
    if(m/\[(\d+)\]/){
	my $new_subject_id = int($1);
	if(defined $act_subject_id){
	    $subject{$act_subject_id} = { %act_subject };
	}
	$act_subject_id = $new_subject_id;
	%act_subject = ();
    } elsif(m/\[kolizje\]/){
	if(defined $act_subject_id){
	    $subject{$act_subject_id} = { %act_subject };
	}
	while(<TERMFILE>){
	    if(m/\d+\s*,\s*\d+(\s*;\d+\s*,\s*\d+)*/){
                chomp;
		my @coll = split(/;/);
		foreach my $sterm1 (@coll){
		    my ($s1, $t1) = split(/,/, $sterm1);
		    foreach my $sterm2 (@coll){
			my ($s2, $t2) = split(/,/, $sterm2);
			$collisions{int($s1)}{int($t1)}{int($s2)}{int($t2)} = 1;
		    }
		}
	    }
	}
	last;
    } elsif(m/(\d+)\s*:\s*(\d+)/){
	$act_subject{int($1)} = int($2);
	$term_cnt++;
    }
}
close(TERMFILE);

## wczytanie preferencji
my $act_student_id = -1;
my %prefs = ();
my %people_subj = ();

open(PREFFILE, "<".($ARGV[0] or "preferencje.txt"));
while(<PREFFILE>){
    if(m/\[(\d+)\]/){
	$act_student_id = int($1);
    } elsif(m/(\d+)\s*:\s*(\d+\s*,\s*\d+(\s*;\s*\d+\s*,\s*\d+)*)/){
	my $subj_id = int($1);
	$people_subj{$subj_id}++;
	my @terms_prefs = split(/;/, $2);
	foreach (@terms_prefs){
	    my ($term, $pref) = split(/,/);
	    $pref = int($pref);
	    $term = int($term);
	    $prefs{$act_student_id}{$subj_id}{$term} = $pref;
	    $minpref = int($pref) if !defined $minpref || $minpref>$pref;
	    $maxpref = int($pref) if $maxpref<$pref;
	    $ndmaxpref = int($pref) if $pref<$maxpref && $pref>$ndmaxpref;
	}
    }
}
close(PREFFILE);

# wczytanie grup
my %groups;
my $total_count = 0;

open(GROUPSFILE, "<".($ARGV[2] or "grupy.txt"));
while(<GROUPSFILE>){
    if(m/^(\d+):(\d+(,\d+)*)/){
        my $subj = int($1);
        my $subj_group = [];
	foreach my $member (split(/,/, $2)){
	    push(@$subj_group, int($member));
	}
        $total_count++;
	push(@{$groups{$subj}}, ($subj_group));
    }
}
close(GROUPSFILE);

##wczytanie planu
my $actstud; 
my %assigned = (); # liczba zapisanych studentow na terminie
my %plan = (); # $plan{student}->{przedmiot} = termin
my $studterms = {}; # plan aktualnego studenta

open(RESULTFILE, "<".($ARGV[3] or "wynik"));
while(<RESULTFILE>){
    if(m/\[(\d+)\]/){
	if(defined $actstud){
	    $plan{$actstud} = $studterms;
	}
	$actstud = int($1);
	$studterms = {};
    } elsif(m/^\s*(\d+)\s*:\s*(\d+)/){
	next unless defined $actstud;
	my $newsubj = int($1); my $newterm = int($2);
	$assigned{$newsubj}->{$newterm}++;
	$studterms->{$newsubj} = $newterm;
    }
}
close(RESULTFILE);
$plan{$actstud} = $studterms;

##obliczenia

my %prefs_for_term = (); # preferencje studentow na poszczegolne terminy
my %results_for_term = (); # preferencje zapisanych na terminy
while (my ($stud, $subj_prefs) = each %prefs){
    while (my ($subj, $term_prefs) = each %$subj_prefs){
	while (my ($term, $pref) = each %$term_prefs){
	    $pref = &$pref_func($pref);
	    $prefs{$stud}{$subj}{$term} = $pref;
	    $prefs_for_term{$subj}{$term}{$pref}++;
	    $results_for_term{$subj}{$term}{$pref} = 0;
	}
    }
}

while (my ($stud, $subject) = each %plan){
    while (my ($subj, $term) = each %$subject){
	$results_for_term{$subj}{$term}{$prefs{$stud}{$subj}{$term}}++;
    }
}

sub in_range {
    my ($val, $lo, $hi) = @_;
    return $val >= $lo && $val <= $hi;
}

sub possible_term {
    my ($stud, $the_subj, $the_term) = @_;
    return 0 unless defined $prefs{$stud}{$the_subj}{$the_term};
    while (my ($subj, $term) = each %{$plan{$stud}}){
	next if $subj == $the_subj;
	return 0 if defined $collisions{$the_subj}{$the_term}{$subj}{$term}; 
    }
    return 1;
}

sub possible_terms {
    my ($stud, $the_subj) = @_;	
    my @result = ();
    if (defined $the_subj){
	foreach my $term (keys %{$subject{$the_subj}}){
	    push @result, $term if possible_term $stud, $the_subj, $term;
	}
    } else {
        foreach my $subj (keys %subject){
	    foreach my $term (keys %{$subject{$subj}}){
    	        push @result, "$subj:$term" if possible_term $stud, $subj, $term;
            }
        }
    }
    return @result;
}

sub assignment {
    my ($stud, $the_subj) = @_;
    if (defined $the_subj){
	return "$stud $plan{$stud}{$the_subj}";
    }
    return "$stud ".(join ' ', map { "$_:$plan{$stud}{$_}" } keys %{$plan{$stud}});
}

sub sorted_terms {
    my @result = ();
    my ($pref_limit_lo, $pref_limit_hi, $subj, $term) = @_;
    $pref_limit_lo = &$pref_func($reversed?$maxpref:$minpref) unless defined $pref_limit_lo;
    $pref_limit_hi = &$pref_func($reversed?$minpref:$maxpref) unless defined $pref_limit_hi;
    while (my ($stud, $subj_prefs) = each %prefs){
        while (my ($subj, $term_prefs) = each %$subj_prefs){
	    push @result, "$subj $stud " . (join ' ', 
		    (sort {$term_prefs->{$a} <=> $term_prefs->{$b}} 
			    (grep {in_range($term_prefs->{$_}, $pref_limit_lo, $pref_limit_hi)} keys %$term_prefs)));
	}
    }
    @result = grep /^$subj\s/, @result if (defined $subj);
    @result = grep {split; grep /^$term$/, @_[2..$#_]} @result if (defined $term);
    return @result;
}

sub top_for_term {
    my ($the_subj, $the_term) = @_;
    while (my ($stud, $subj_prefs) = each %prefs){
        while (my ($subj, $term_prefs) = each %$subj_prefs){
	    print "$subj $stud ", (join ' ', (sort {$term_prefs->{$a} <=> $term_prefs->{$b}} keys %$term_prefs)), "\n";
	}
    }        
}

sub terms_details {
    my $total_max_achieve = 0; # nie dziala bez -v
    my $total_achieved = 0;
    my @result = ();
    for my $subj (sort {$a <=> $b} (keys %subject)) {
        my $terms = $subject{$subj};
        for my $term (sort {$a <=> $b} (keys %$terms)) {
    	    my $max = $subject{$subj}->{$term};
	    my $act = $assigned{$subj}->{$term};
	    my $achieved = 0;
	    my $max_achieve = 0;
	    push @result, "Term: $subj $term, available: $max, assigned: $act";
	    for my $pref (sort {($a <=> $b)*($reversed?-1:1)} (keys %{$prefs_for_term{$subj}{$term}})){
		my $cnt = $prefs_for_term{$subj}{$term}{$pref};
		my $act = $results_for_term{$subj}{$term}{$pref};
		push @result, ($max>0?"*":" ")."   $pref: $cnt, assigned: $act";
		if ($max > $cnt){
		    $max_achieve += $cnt * $pref;
		} elsif ($max > 0) {
		    $max_achieve += $max * $pref;
		}
		$achieved += $act * $pref;
		$max -= $cnt;
		last if $max<=0 && !$verbose;
	    }
	    push @result, "Achieved: $achieved, " . ($reversed?"max:":"min:") . " $max_achieve" if $verbose;
	    $total_max_achieve += $max_achieve;
	    $total_achieved += $achieved;
	}
    }

    push @result, "\nAchieved: $total_achieved, " . ($reversed?"max:":"min:") . " $total_max_achieve" if $verbose;
    return @result;
}

sub help {
    return ("Available commands:",
    "  sorted_terms([min_pref[, max_pref[, subject[, term]]]])",
    "    Returns list of terms for every student and subject so that
student's preference for each term is between min_pref and max_pref. If subject is provided,
returns only terms of this subject. If term is specified, returns only list of terms
containing specified term.\n",
    "  top_for_term",
    "  terms_details()",
    "    Returns detailed list of assigned points distribution for each term.\n",
    "  assignment(student[, subject])",
    "    Returns specified student's assignment.\n",
    "  possible_term(student, subject, term)",
    "    Returns 1 if student can be assigned specified term.\n",
    "  possible_terms(student[, subject])",
    "    Returns list of all possible terms for specified student.\n");
}

my @students = keys %prefs;

my $terminal = new Term::ReadLine 'Happiness statistics';
my $out = $terminal->OUT || \*STDOUT;

print Term::Features;

while( defined ( $_ = $terminal->readline("> ") ) ){
    print $out join "\n", "\n", eval $_;
    $terminal->addhistory($_);
}
